home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr53 / 122_01.zip / PIST2C.C < prev    next >
Text File  |  1993-06-02  |  3KB  |  203 lines
  1. /*********************************************************/
  2. /*                             */
  3. /* PISTOL-Portably Implemented Stack Oriented Language     */
  4. /*            Version 2.0             */
  5. /* (C) 1983 by    Ernest E. Bergmann             */
  6. /*        Physics, Building #16             */
  7. /*        Lehigh Univerisity             */
  8. /*        Bethlehem, Pa. 18015             */
  9. /*                             */
  10. /* Permission is hereby granted for all reproduction and */
  11. /* distribution of this material provided this notice is */
  12. /* included.                         */
  13. /*                             */
  14. /*********************************************************/
  15. /* fourth code module for PISTOL v2.0 in BDS 'C' v1.45a */
  16. /*Feb 19,'83: fix load() when tos<1 */
  17. /* August 28, 1982 */
  18. #include "bdscio.h"
  19. #include "pistol.h"
  20.  
  21. /* primitive interpreter functions */
  22. /* static int tos; */
  23.  
  24. psemcol()
  25. { ip=rstack[rptr--]; }
  26.  
  27. wstore()
  28. {    Pw=pop();
  29.     if((Pw<ram)||(Pw>&ram[RAMSIZE])) merr(writv);
  30.     *Pw = pop();
  31. }
  32.  
  33. times()
  34. { push( pop()*pop() ); }
  35.  
  36. plus()
  37. { push( pop()+pop() ); }
  38.  
  39. subtract()
  40. { tos=pop(); push( pop()-tos ); }
  41.  
  42. divmod()
  43. {    tos=pop();
  44.     temp=pop();
  45.     if(tos)
  46.         {push(temp/tos);
  47.         push(temp%tos);
  48.         }
  49.     else merr(divby0);
  50. }
  51.  
  52. pif()
  53. {    if(pop()) ip += W;
  54.     else { Pw=ip; ip += *Pw; }
  55. }
  56.  
  57. wat()
  58. {    Pw=pop();
  59.     if((Pw<&ram[RAMMIN])||(Pw>&ram[RAMSIZE]))
  60.          merr(readv);
  61.     push( *Pw );
  62. }
  63.  
  64. sp()
  65. { push(stkptr); }
  66.  
  67. load()
  68. {    ram[7].pc=tos=pop();
  69.     if((tos>MAXLINNO)||(tos<1))
  70.         {push(tos); fname(infil);
  71.         if(fopen(infil,ldfil) == ERROR)
  72.             {printf("can't open %s\n",infil);
  73.             /*????*/ abort();
  74.             }
  75.         ram[25].in=0;
  76.         }
  77. }
  78.  
  79. pelse()
  80. { Pw=ip; ip += *Pw; }
  81.  
  82. wrd()
  83. { push(W); }
  84.  
  85. rp()
  86. { push(rptr); }
  87.  
  88. puser()
  89. { push(ram); }
  90.  
  91. exec()
  92. {    instr=pop();
  93.     if(instr<NFUNCS) (*farray[instr])();
  94.     else    {if((instr<&ram)||(instr>&ram[RAMSIZE]))
  95.             merr(readv);
  96.         rpush(ip); ip=instr;
  97.         }
  98. }
  99.  
  100. exitop()
  101. {    if(lptr<3) abort();
  102.     else lstack[lptr]=lstack[lptr-1];
  103. }
  104.  
  105. lit()
  106. { Pw=ip; push(*Pw); ip+=W ; }
  107.  
  108. rpop()
  109. { push(rstack[rptr]); rptr--; }
  110.  
  111. tyo()
  112. { chout(pop()) ; }
  113.  
  114. rpsh()
  115. { rpush( pop() ); }
  116.  
  117. semicf()
  118. {    if(ram[20].in) carret();
  119.     if((ram[7].in<MAXLINNO)&&(ram[7].in>0))
  120.         {ram[7].in--;
  121.         printf("\n THROUGH LINE %d(DECIMAL) LOADED\n",
  122.             ram[7].in);
  123.         if(ram[8].in)
  124.             fprintf(list,
  125.             "\n THROUGH LINE %d(DECIMAL) LOADED\n",
  126.             ram[7].in);
  127.         }
  128.     if(ram[7].in>=MAXLINNO)
  129.         {printf("%s LOADED\n", infil);
  130.         if(ram[8].in) fprintf(list,
  131.                 "%s LOADED\n",infil);
  132.         }
  133.     ram[7].in=0;
  134. }
  135.  
  136. rat()
  137. {    tos=rptr-pop();
  138.     if(tos<0) merr(readv);
  139.     push(rstack[tos]);
  140. }
  141.  
  142. compme()
  143. {    Pw2=ip;Pw2 -=4; j=*Pw2;Pw2=ip;
  144.     while(Pw2<j) {compile(*Pw2); Pw2++; }
  145.     ip=rstack[rptr--];
  146. }
  147.  
  148. comphere()
  149. {    compile(ip);
  150.     ip=stack[rptr--];
  151. }
  152.  
  153. dollarc()
  154. {    pushck('$');compile(PDOLLAR);
  155.     fwdref();
  156. }
  157.  
  158. colon()
  159. {    pushck(':');compile(PCOLON);
  160.     fwdref();
  161. }
  162.  
  163. semcol()
  164. {    if(strings[1+strings[1]]==':')
  165.         {dropck();compile(PSEMICOLON);touchup(); }
  166.     else synterr();
  167. }
  168.  
  169. ifop()
  170. { pushck('F'); compile(PIF); fwdref(); }
  171.  
  172. elseop()
  173. {    if(strings[1+strings[1]]=='F')
  174.         {strings[1+strings[1]]='E';
  175.         compile(PELSE); fwdref();
  176.         swap(); touchup();
  177.         }
  178.     else synterr();
  179. }
  180.  
  181. thenop()
  182. {    Pc= &strings[1]; Pc += *Pc;
  183.     if((*Pc=='F')||(*Pc=='E')) {dropck();touchup();}
  184.     else synterr();
  185. }
  186.  
  187. doop()
  188. { pushck('D');compile(PDOOP);fwdref(); }
  189.  
  190. loopop()
  191. {    if(strings[1+strings[1]]=='D')
  192.         {dropck();compile(PLOOP);
  193.         compile(stack[stkptr]-ram[1].in+W);
  194.         touchup();
  195.         }
  196.     else synterr();
  197. }
  198. 
  199.         }
  200.     ram[7].in=0;
  201. }
  202.  
  203.